{-# LANGUAGE CPP #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

#if __GLASGOW_HASKELL__ >= 908
{-# OPTIONS_GHC -Wno-x-partial #-}
#endif

module Cardano.Tracer.Handlers.RTView.Update.Peers
  ( updateNodesPeers
  ) where

import           Cardano.Logging (showT)
import           Cardano.Node.Tracing.Peers
import           Cardano.Tracer.Environment
import           Cardano.Tracer.Handlers.RTView.State.Peers
import           Cardano.Tracer.Handlers.RTView.UI.HTML.Node.Peers
import           Cardano.Tracer.Handlers.RTView.UI.Utils
import           Cardano.Tracer.Handlers.RTView.Utils
import           Cardano.Tracer.Handlers.Utils
import           Cardano.Tracer.Types

import           Control.Monad (forM_, void)
import           Control.Monad.Extra (whenJustM)
import           Data.List (find)
import           Data.List.Extra (notNull)
import           Data.Maybe (mapMaybe)
import           Data.Set ((\\))
import qualified Data.Set as S
import           Data.Text (unpack)
import qualified Data.Text as T

import qualified Graphics.UI.Threepenny as UI
import           Graphics.UI.Threepenny.Core

updateNodesPeers
  :: TracerEnv
  -> Peers
  -> UI ()
updateNodesPeers tracerEnv@TracerEnv{teDPRequestors, teCurrentDPLock} displayedPeers = do
  window <- askWindow
  forConnectedUI_ tracerEnv $ \nodeId -> do
    whenJustM (liftIO $ askDataPoint teDPRequestors teCurrentDPLock nodeId "NodePeers") $
      doUpdatePeers window nodeId displayedPeers

doUpdatePeers
  :: UI.Window
  -> NodeId
  -> Peers
  -> NodePeers
  -> UI ()
doUpdatePeers window nodeId@(NodeId anId) displayedPeers (NodePeers peersParts) = do
  -- Update peers number.
  setTextValue (anId <> "__node-peers-num") (showT (length peersParts))
  -- If there is at least one connected peer, we enable 'Details' button.
  findAndSet (set UI.enabled $ notNull peersParts)
             window $ anId <> "__node-peers-details-button"
  -- Update particular info about peers.
  let connectedPeers = getConnectedPeers
      connectedPeersAddresses = getConnectedPeersAddresses
  displayedPeersAddresses <- liftIO $ getPeersAddresses displayedPeers nodeId
  if displayedPeersAddresses /= connectedPeersAddresses
    then do
      -- There are some changes with number of peers: some new were connected
      -- and/or some displayed ones were disconnected.
      let disconnectedPeers   = displayedPeersAddresses \\ connectedPeersAddresses -- Not in connected
          newlyConnectedPeers = connectedPeersAddresses \\ displayedPeersAddresses -- Not in displayed
      deleteRowsForDisconnected disconnectedPeers
      addRowsForNewlyConnected newlyConnectedPeers connectedPeers
    else
      -- No changes with number of peers, only their data was changed.
      updateConnectedPeersData connectedPeers
 where
  getConnectedPeers = S.fromList $
    mapMaybe
      (\peerPart -> let peerData = T.words peerPart in
                    if length peerData == 6 then Just peerData else Nothing
      ) peersParts

  getConnectedPeersAddresses = S.map head getConnectedPeers

  deleteRowsForDisconnected disconnected =
    forM_ disconnected $ \peerAddr -> do
      deletePeerRow window nodeId peerAddr
      liftIO $ removePeer displayedPeers nodeId peerAddr

  addRowsForNewlyConnected newlyConnectedPeers connectedPeers =
    forM_ newlyConnectedPeers $ \peerAddr -> do
      case find (\peerDataList -> head peerDataList == peerAddr) connectedPeers of
        Just [_, status, slotNo, reqsInF, blocksInF, bytesInF] -> do
          let idPrefix = anId <> peerAddr
          addPeerRow idPrefix peerAddr status slotNo reqsInF blocksInF bytesInF
          liftIO $ addPeer displayedPeers nodeId peerAddr
        _ -> return ()

  addPeerRow idPrefix peerAddr status slotNo reqsInF blocksInF bytesInF = do
    let idPrefix' = unpack idPrefix
    whenJustM (UI.getElementById window (unpack anId <> "__node-peers-tbody")) $ \el ->
      void $ element el #+
        [ UI.tr ## (idPrefix' <> "__node-peer-row") #+
            [ UI.td #+
                [ UI.span ## (idPrefix' <> "__address")
                          #. "is-family-monospace"
                          # set text (unpack peerAddr)
                ]
            , UI.td #+
                [ UI.span ## (idPrefix' <> "__status")
                          # set text (unpack status)
                ]
            , UI.td #+
                [ UI.span ## (idPrefix' <> "__slotNo")
                          # set text (unpack $ checkSlot slotNo)
                ]
            , UI.td #+
                [ UI.span ## (idPrefix' <> "__reqsInF")
                          # set text (unpack reqsInF)
                ]
            , UI.td #+
                [ UI.span ## (idPrefix' <> "__blocksInF")
                          # set text (unpack blocksInF)
                ]
            , UI.td #+
                [ UI.span ## (idPrefix' <> "__bytesInF")
                          # set text (unpack bytesInF)
                ]
            ]
        ]

  updateConnectedPeersData connectedPeers = do
    let allPeersData = concatMap collectDataToUpdate (S.toList connectedPeers)
    -- Update values for all peers by one single FFI-call.
    setTextValues allPeersData

  collectDataToUpdate [peerAddr, status, slotNo, reqsInF, blocksInF, bytesInF] =
    let idPrefix = anId <> peerAddr
    in [ (idPrefix <> "__status",    status)
       , (idPrefix <> "__slotNo",    checkSlot slotNo)
       , (idPrefix <> "__reqsInF",   reqsInF)
       , (idPrefix <> "__blocksInF", blocksInF)
       , (idPrefix <> "__bytesInF",  bytesInF)
       ]
  collectDataToUpdate _ = []

  checkSlot slotNo = if slotNo == "???" then "—" else slotNo
